Shareware Grab Bag/Shareware Grab Bag.iso/003/pssst.arc/PSSUSPEN.PRG

Text File | 1986-07-15 | 8.5 KB | 336 lines

* PSSUSPEN.PRG
*
* A DBASE II 16BIT COMMAND FILE to allow input or creation of
* filename, and display of suspenses.  Control is then shifted
* back to PSSST.PRG for main menu options.
*
* Version 1
* By LTC Denny Hugg
* ANGSC/DOS Andrews AFB MD 16 Jul 1985
*
* Version 2
* modified by Maj Jim McMurry
* ANGSC/DOSC Truax Field, WI 15 Jun 1986
*
ERASE
STORE 'S U S P E N S E   T R A C K I N G   S Y S T E M' TO heading
DO PSHEADING
STORE ' ' TO moutput
@ 22,14 SAY 'Do You Want Suspenses On Screen Or Printer? (S/P) '
DO WHILE moutput <> 'S' .AND. moutput <> 'P'
   STORE ' ' TO moutput
   @ 22,64 GET moutput PICTURE '!'
   READ
ENDDO
@ 22, 0 SAY gclearline
* --- to determine 7 day suspense taking into account various months
* --- and leap years
STORE VAL($(gdate,1,2)) TO year
STORE VAL($(gdate,4,2)) TO month
STORE VAL($(gdate,7,2)) TO day
DO CASE
   CASE (month = 4 .OR. month = 6) .OR. (month = 9 .OR. month = 11)
      IF day > 23
         STORE day - 23 TO mday
         STORE month + 1 TO mmonth
         STORE year TO myear
      ELSE
         STORE day + 7 TO mday
         STORE month TO mmonth
         STORE year TO myear
      ENDIF
   CASE month = 2
      IF INT(year/4) <> year/4 .OR. INT(year/100) <> 0
         IF day > 21
            STORE day - 21 TO mday
            STORE 3 TO mmonth
            STORE year TO myear
         ELSE
            STORE day + 7 TO mday
            STORE 2 TO mmonth
            STORE year TO myear
         ENDIF
      ELSE
         IF day > 22
            STORE day - 22 TO mday
            STORE 3 TO mmonth
            STORE year TO myear
         ELSE
            STORE day + 7 TO mday
            STORE 2 TO mmonth
            STORE year TO myear
         ENDIF
      ENDIF
   OTHERWISE
      IF day > 24
         STORE day - 24 TO mday
         STORE month + 1 TO mmonth
         STORE year TO myear
      ELSE
         STORE day + 7 TO mday
         STORE month TO mmonth
         STORE year TO myear
      ENDIF
ENDCASE
STORE STR(myear,2) + '/' TO mdate7
IF mmonth > 9
   STORE mdate7 + STR(mmonth,2) + '/' TO mdate7
ELSE
   STORE mdate7 + '0' + STR(mmonth,1) + '/' TO mdate7
ENDIF
IF mday > 9
   STORE mdate7 + STR(mday,2) TO mdate7
ELSE
   STORE mdate7 + '0' + STR(mday,1) TO mdate7
ENDIF
@ 10, 0 SAY gclearline
* --- indexing is more efficient than sorting for the variety of our tasks
USE &gsusfile INDEX &gsusindex
* --- IF EOF
IF # = 0
* --- nobody home so let's go somewhere else
   USE
   STORE 10 TO line
   STORE 'No Suspense Items Stored ' + gfirstname TO prompt
   DO PSPROMPT
   STORE 0 TO mcount
   DO WHILE mcount < gdelay
      STORE mcount + 1 TO mcount
   ENDDO
* --- release local variables
   RELEASE ALL EXCEPT g*
   RETURN
ENDIF
* --- print suspenses
IF moutput = 'P'
   STORE 56 TO mpagelen
   STORE 1 TO pageno
   STORE 22 TO line
   STORE 'N' TO gflag
   STORE 'Printing Now ...' TO prompt
   DO PSPROMPT
   STORE 'Y' TO gflag
   SET FORMAT TO PRINT
   STORE 2 TO mline
   STORE '----------------------------------------';
        +'----------------------------------------' TO gline
ELSE
   ERASE
   STORE 20 TO mpagelen
   STORE 1 TO mline
ENDIF
IF moutput = 'P'
   @ mline, 1 SAY 'Page no. ' + STR(pageno,1)
   @ mline,24 SAY 'S U S P E N S E   L I S T I N G'
   @ mline,71 SAY gdate
   STORE mline + 1 TO mline
ELSE
   STORE mline TO line
   STORE 'SUSPENSE LISTING' TO prompt
   DO PSPROMPT
ENDIF
STORE mline + 2 TO mline
* --- find overdue stuff
STORE 0 TO mpasses
@ mline, 0 SAY 'DUE DATE'
@ mline,10 SAY 'SUSPENSE ITEM'
@ mline,66 SAY 'TASKED BY'
STORE mline + 1 TO mline
@ mline, 0 SAY gline
STORE mline + 1 TO mline
@ mline, 10 SAY 'Overdue Items:'
STORE mline + 1 TO mline
DO WHILE .NOT. EOF
   IF mline > mpagelen
      STORE 2 TO mline
      IF moutput = "S"
         @ 22,21 SAY "- Please Strike Any Key To Continue -"
         SET CONSOLE OFF
         WAIT
         SET CONSOLE ON
         ERASE
      ELSE
         EJECT
         STORE pageno + 1 TO pageno
         @ mline, 0 SAY 'Page no. ' + STR(pageno,1)
         @ mline,72 SAY gdate
         STORE mline + 3 To mline
      ENDIF
      @ mline, 0 SAY 'DUE DATE'
      @ mline,10 SAY 'SUSPENSE ITEM'
      @ mline,66 SAY 'TASKED BY'
      STORE mline + 1 TO mline
      @ mline, 0 SAY gline
      STORE mline + 1 TO mline
   ENDIF
   IF gdate > duedate
      @ mline, 0 SAY duedate
      @ mline,10 SAY descrip
      @ mline,66 SAY origin
      STORE mline + 1 TO mline
      STORE mpasses + 1 TO mpasses
   ENDIF
   SKIP
ENDDO gdate > duedate
IF mpasses = 0
   STORE mline - 1 TO mline
   @ mline,26 SAY "None"
   STORE mline + 1 TO mline
ENDIF
IF moutput = "S"
   STORE mline + 1 TO mline
ELSE
   STORE mline + 2 TO mline
ENDIF
GO TOP
* --- find stuff due today
STORE 0 TO mpasses
@ mline, 10 SAY 'Items Due Today:'
STORE mline + 1 TO mline
DO WHILE .NOT. EOF
   IF mline > mpagelen
      STORE 2 TO mline
      IF moutput = "S"
         @ 22,21 SAY "- Please Strike Any Key To Continue -"
         SET CONSOLE OFF
         WAIT
         SET CONSOLE ON
         ERASE
      ELSE
         EJECT
         STORE pageno + 1 TO pageno
         @ mline, 0 SAY 'Page no. ' + STR(pageno,1)
         @ mline,72 SAY gdate
         STORE mline + 3 TO mline
      ENDIF
      @ mline, 0 SAY 'DUE DATE'
      @ mline,10 SAY 'SUSPENSE ITEM'
      @ mline,66 SAY 'TASKED BY'
      STORE mline + 1 TO mline
      @ mline, 0 SAY gline
      STORE mline + 1 TO mline
   ENDIF
   IF gdate = duedate
      @ mline, 0 SAY duedate
      @ mline,10 SAY descrip
      @ mline,66 SAY origin
      STORE mline + 1 TO mline
      STORE mpasses + 1 TO mpasses
   ENDIF
   SKIP
ENDDO  gdate = duedate
IF mpasses = 0
   STORE mline - 1 TO mline
   @ mline,28 SAY 'None'
   STORE mline + 1 TO mline
ENDIF
IF moutput = 'S'
   STORE mline + 1 TO mline
ELSE
   STORE mline + 2 TO mline
ENDIF
* --- find stuff due in next 7 days
GO TOP
STORE 0 TO mpasses
@ mline, 10 SAY 'Items Due In The Next 7 Days:'
STORE mline + 1 TO mline
DO WHILE .NOT. EOF
   IF mline > mpagelen
      STORE 2 TO mline
      IF moutput = "S"
         @ 22,21 SAY "- Please Strike Any Key To Continue -"
         SET CONSOLE OFF
         WAIT
         SET CONSOLE ON
         ERASE
      ELSE
         EJECT
         STORE pageno + 1 TO pageno
         @ mline, 0 SAY 'Page no. ' + STR(pageno,1)
         @ mline,72 SAY gdate
         STORE mline + 3 TO mline
      ENDIF
      @ mline, 0 SAY 'DUE DATE'
      @ mline,10 SAY 'SUSPENSE ITEM'
      @ mline,66 SAY 'TASKED BY'
      STORE mline + 1 TO mline
      @ mline, 0 SAY gline
      STORE mline + 1 TO mline
   ENDIF
   IF gdate < duedate .AND. duedate <= mdate7
      @ mline, 0 SAY duedate
      @ mline,10 SAY descrip
      @ mline,66 SAY origin
      STORE mline + 1 TO mline
      STORE mpasses + 1 TO mpasses
    ENDIF
    SKIP
ENDDO next 7 days
IF mpasses = 0
   STORE mline - 1 TO mline
   @ mline,41 SAY 'None'
   STORE mline + 1 TO mline
ENDIF
IF moutput = 'S'
   STORE mline + 1 TO mline
ELSE
   STORE mline + 2 TO mline
ENDIF
STORE 0 TO mpasses
@ mline, 10 SAY 'Other Suspenses Facing You:'
STORE mline + 1 TO mline
GO TOP
* --- find stuff due after next week
DO WHILE .NOT. EOF
   IF mline > mpagelen
      STORE 2 TO mline
      IF moutput = "S"
         @ 22,21 SAY "- Please Strike Any Key To Continue -"
         SET CONSOLE OFF
         WAIT
         SET CONSOLE ON
         ERASE
      ELSE
         EJECT
         STORE pageno + 1 TO pageno
         @ mline, 0 SAY 'Page no. ' + STR(pageno,1)
         @ mline,72 SAY gdate
         STORE mline + 3 TO mline
      ENDIF
      @ mline, 0 SAY 'DUE DATE'
      @ mline,10 SAY 'SUSPENSE ITEM'
      @ mline,66 SAY 'TASKED BY'
      STORE mline + 1 TO mline
      @ mline, 0 SAY gline
      STORE mline + 1 TO mline
   ENDIF
   IF duedate > mdate7
      @ mline, 0 SAY duedate
      @ mline,10 SAY descrip
      @ mline,66 SAY origin
      STORE mline + 1 TO mline
      STORE mpasses + 1 TO mpasses
   ENDIF
   SKIP
ENDDO suspenses beyond a week
IF mpasses = 0
   STORE mline - 1 TO mline
   @ mline,39 SAY 'None'
   STORE mline + 1 TO mline
ENDIF
USE
IF moutput = "S"
   @ 22,21 SAY "- Please Strike Any Key To Continue -"
   SET CONSOLE OFF
   WAIT
   SET CONSOLE ON
ELSE
* --- dumps last line out of printer buffer
   @ 0, 0 SAY CHR(13)
   SET FORMAT TO SCREEN
ENDIF
RELEASE ALL EXCEPT g*
ERASE
RETURN
* --- EOF PSSUSPEN.PRG